(define-module (gpetro eclipse data)
  #:use-module (ice-9 binary-ports)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-4)
  #:use-module (system foreign)
  #:export (parse))

(define (parse port)
  (let ((file-endianness (guess-file-endianness port)))
    (if file-endianness
        (let loop ((records '()))
          (let ((header (get-header port file-endianness)))
            (cond ((eof-object? header)
                   records)
                  ((not header)
                   (display "Warning: File possibly corrupted.")
                   (newline)
                   records)
                  (else
                   (let ((data (get-data port header file-endianness)))
                     (cond ((not (bytevector? data))
                            (display "Warning: File possibly corrupted.")
                            (newline)
                            records)
                           (else
                            ;; (display header)
                            ;; (display data)
                            ;; (newline)
                            (set! records (append! records (list (cons header data))))
                            (loop records)))))))))))


;; Each data header contains 8 bytes of char[] (record name), 4 bytes
;; of an int (number of data elements), and 4 bytes of char[] (data
;; type name). These data are padded by 4 bytes int at both ends.

;; Guess the endianness of the binary file by looking at its first
;; four bytes. Because the pad integer at both end of a header should
;; be 16, those four bytes should always be 16.

(define (guess-file-endianness port)
  (let* ((current-position (ftell port))
         (raw-bytes (get-bytevector-n port 4))
         (test-big (bytevector-u32-ref raw-bytes 0 'big))
         (test-little (bytevector-u32-ref raw-bytes 0 'little))
         (result (cond
                  ((= test-big 16) 'big)
                  ((= test-little 16) 'little)
                  (else #f))))
    (seek port current-position SEEK_SET)
    result))

(define sizeof-int 4)

(define (get-u32 port endianness)
  (let ((raw-bytes (get-bytevector-n port sizeof-int)))
    (cond ((eof-object? raw-bytes)
           (eof-object))
          ((and (bytevector? raw-bytes) (= (bytevector-length raw-bytes) sizeof-int)) 
           (bytevector-u32-ref raw-bytes 0 endianness))
          (else #f))))

(define (get-string-n port n)
  (let* ((raw-bytes (get-bytevector-n port n)))
    (cond ((eof-object? raw-bytes) (eof-object))
          ((and (bytevector? raw-bytes) (= (bytevector-length raw-bytes) n))
           (utf8->string raw-bytes))
          (else #f))))

(define (get-record-bytevector port file-endianness)
  (let ((pad1 (get-u32 port file-endianness)))
    (cond ((eof-object? pad1) (eof-object))
          ((integer? pad1)
           (let* ((raw-bytes (get-bytevector-n port pad1))
                  (pad2 (get-u32 port file-endianness)))
             (if (and (bytevector? raw-bytes)
                      (= pad2 pad1)
                      (= (bytevector-length raw-bytes) pad1))
                 raw-bytes
                 #f)))
          (else #f))))

(define (get-header port file-endianness)
  (let* ((pad1 (get-u32 port file-endianness))
         (key (get-string-n port 8))
         (length (get-u32 port file-endianness))
         (type (get-string-n port 4))
         (pad2 (get-u32 port file-endianness)))
    (cond ((eof-object? pad1) (eof-object))
          ((and (= pad1 16) (= pad2 16))
           (list key length type))
          (else #f))))

(define (get-data port header file-endianness)
  (let* ((key (car header))
         (n (cadr header))
         (type (caddr header))
         (total-bytes
          (cond ((equal? type "INTE") (* 4 n))
                ((equal? type "CHAR") (* 8 n))
                ((equal? type "REAL") (* 4 n))
                ((equal? type "DOUB") (* 8 n)))))
    (let ((raw-bytes (get-record-bytevector port file-endianness)))
      (if (bytevector? raw-bytes)
          (let ((read-bytes (bytevector-length raw-bytes)))
            (cond ((= read-bytes total-bytes)
                   (change-to-native-endianness raw-bytes file-endianness type))
                  ((> read-bytes total-bytes) #f)
                  (else
                   (let loop ((data (make-bytevector total-bytes 0))
                              (i 0)
                              (raw raw-bytes))
                     (if (not (bytevector? raw))
                         #f
                         (begin
                           (vector-move-left! raw 0 (bytevector-length raw) data i)
                           (set! i (+ i (bytevector-length raw)))
                           (cond ((= i total-bytes) (change-to-native-endianness data file-endianness))
                                 ((> i total-bytes) #f)
                                 (else (loop (data i (get-record-bytevector port file-endianness type)))))))))))))))

(define (change-to-native-endianness data file-endianness type)
  (if (or (eq? file-endianness (native-endianness))
          (equal? type "CHAR"))
      data
      (let ((n (bytevector-length data))
            (word (cond ((equal? type "DOUB") 8)
                        ((or (equal? type "INTE")
                             (equal? type "REAL")) 4))))
        (cond ((= word 4)
               (let loop ((i 0))
                 (if (>= i n)
                     data
                     (let ((ele (bytevector-u32-ref data i 'big)))
                       (bytevector-u32-set! data i ele 'little)
                       (loop (+ i 4))))))
              ((= word 8)
               (let loop ((i 0))
                 (if (>= i n)
                     data
                     (let ((ele (bytevector-u64-ref data i 'big)))
                       (bytevector-u64-set! data i ele 'little)
                       (loop (+ i 8))))))))))



